(DEFPROP FOROUTFNS
 (FOROUTFNS (SPECIAL PRINRADCTAB)
	    PRINENTRY
	    PRINCTAB
	    NUMNODES
	    PRINRAD1
	    PRINRAD
	    LAYOUT
	    PRINNUM
	    FORFILE
	    PICTURESTO
	    SPACES
	    CLOSEFIL
	    (SETQ FORFILE NIL))
VALUE)

(SPECIAL PRINRADCTAB)

(DEFPROP PRINENTRY
 (LAMBDA (N AT CON) (SETQ PRINRADCTAB (CONS (CONS N (CONS AT CON)) PRINRADCTAB)))
EXPR)

(DEFPROP PRINCTAB
 (LAMBDA(CTAB TTABLE)
  (FOR NEW
       CT
       IN
       CTAB
       AS
       NEW
       CPRIME
       IS
       (LMASSOC (NODENUM CT) TTABLE NIL)
       DO
       (PRINENTRY (CAR CPRIME)
		  (ATOMTYPE MARKERS CT)
		  (APPEND (CDR CPRIME)
			  (FOR NEW
			       Y
			       IN
			       (NBRS CT)
			       IF
			       (NOT (EQ Y (QUOTE FV)))
			       XLIST
			       (CAR (LMASSOC Y TTABLE NIL)))))))
EXPR)

(DEFPROP NUMNODES
 (LAMBDA(RAD)
  (FOR NEW
       R
       IN
       (ATTACHEDRADS RAD)
       PLUS
       FIRST
       (COND ((NULL (CENTER RAD)) 0.)
	     ((ATOM (CENTER RAD)) 1.)
	     ((NOT (STRUCTURE? (RADSTRUC (CENTER RAD)))) 1.)
	     (T (LENGTH (NODES (RADSTRUC (CENTER RAD))))))
       (TIMES (CDR R) (NUMNODES (CAR R)))))
EXPR)

(DEFPROP PRINRAD1
 (LAMBDA(EFF AA RAD)
  (PROG	(CENT ATTACHED J X TTABLE)
	(SETQ CENT (CENTER RAD))
	(SETQ ATTACHED (CLEXPAND (ATTACHEDRADS RAD)))
	(RETURN
	 (COND ((NOT CENT)
		(PRINRAD1 (CADR AA)
			  (CONS (CAR AA) (PRINRAD1 (CAR AA) (CDR AA) (CAR ATTACHED)))
			  (CADR ATTACHED)))
	       ((OR (ATOM CENT) (NOT (EQ (ID (RADSTRUC CENT)) (QUOTE STRUC))))
		(SETQ X (CDR AA))
		(FOR NEW R IN ATTACHED DO (SETQ J (CONS (CAR X) J)) (SETQ X (PRINRAD1 (CAR AA) X R)))
		(PRINENTRY (CAR AA) CENT (COND (EFF (CONS EFF J)) (T J)))
		X)
	       (T (SETQ	X
			(COND ((NOT EFF) AA)
			      (T (SETQ TTABLE (LIST (LIST (AFFLINK CENT) (CAR AA) EFF))) (CDR AA))))
		  (FOR NEW
		       N
		       IN
		       (NODES (RADSTRUC CENT))
		       WHEN
		       (NOT (EQUAL N (AFFLINK CENT)))
		       DO
		       (SETQ TTABLE (CONS (LIST N (CAR X)) TTABLE))
		       (SETQ X (CDR X)))
		  (FOR NEW
		       NLIST
		       IN
		       (CUFFLINKS CENT)
		       FOR
		       NEW
		       C
		       IN
		       NLIST
		       AS
		       NEW
		       CT
		       IS
		       (LMASSOC C TTABLE NIL)
		       DO
		       (NCONC CT (LIST (CAR X)))
		       (SETQ X (PRINRAD1 (CAR CT) X (CAR ATTACHED)))
		       (SETQ ATTACHED (CDR ATTACHED)))
		  (PRINCTAB (CTABLE (RADSTRUC CENT)) TTABLE)
		  X)))))
EXPR)

(DEFPROP PRINRAD
 (LAMBDA(L)
  (PROG	(PRINRADCTAB)
	(PRINRAD1 NIL (FOR NEW I := ((NUMNODES L) 1. -1.) XLIST I) L)
	(LAYOUT (CONS TITLE PRINRADCTAB))))
EXPR)

(DEFPROP LAYOUT
 (LAMBDA(CTAB)
  (PROG	(*NOPOINT OLDCHAN)
	(SETQ *NOPOINT T)
	(SETQ OLDCHAN (OUTC (FORFILE)))
	(PRINNUM (LENGTH (CDR CTAB)) 5.)
	(PRINNUM (PICTURESTO) 3.)
	(TERPRI)
	(FOR NEW
	     X
	     IN
	     (CDR CTAB)
	     DO
	     (PRINNUM (CAR X) 3.)
	     (TAB 5.)
	     (PRINC (CADR X))
	     (TAB 7.)
	     (FOR NEW Y IN (CDDR X) WHEN (NUMBERP Y) DO (PRINNUM Y 3.))
	     (TERPRI))
	(PRINC (CAR CTAB))
	(TERPRI)
	(PRINC (QUOTE "END*"))
	(TERPRI)
	(OUTC OLDCHAN NIL)))
EXPR)

(DEFPROP PRINNUM
 (LAMBDA (N WIDTH) (PROG NIL (SPACES (DIFFERENCE WIDTH (FLATSIZEC N))) (PRINC N)))
EXPR)

(DEFPROP FORFILE
 (LAMBDA NIL (COND (FORFILE FORFILE) (T (SETQ FORFILE (OUTPUT FORFILECHAN DSK: (FOR01 . DAT))))))
EXPR)

(DEFPROP FORFILE
 (FORFILE)
VALUE)

(DEFPROP PICTURESTO
 (LAMBDA NIL 5.)
EXPR)

(DEFPROP SPACES
 (LAMBDA (X) (FOR X := (X 1. -1.) DO (PRINC (QUOTE " "))))
EXPR)

(DEFPROP CLOSEFIL
 (LAMBDA NIL (OUTC FORFILE NIL) (OUTC NIL T) (SETQ FORFILE NIL))
EXPR)

(SETQ FORFILE NIL)